As part of my further experiments with GTK4 and Haskell, I wanted to vary gtk-picture by creating the Picture programatically. I named the alternative gtk-dynamic-picture.

Diagrams

I created the picture using the Diagrams project. I looked at various backends:

the diagrams-gtk package, based on Cairo, renders to values of the gtk package, not the gi-gtk package;
the diagrams-cairo package can render to a buffer in memory with the pixel format CAIRO_FORMAT_ARGB32. That format has alpha in the upper byte, then red, then green, then blue. The pixels are, however, stored native-endian; that is, on little endian tx86_64, the order of the bytes is B G R A. Also, pre-multiplied alpha is used. (For example, 50% transparent red is 0x80800000, not 0x80ff0000.); and
the diagrams-rasterific package, based on the Rasterific package, renders to values of type Image PixelRGBA8 (provided by the JuicyPixels package). Pixels are stored in the order R G B A.

Ultimately, given the pixel format of a Pixbuf value (R G B A), I used diagrams-rasterific as the backend.

The first step was to yield an Image PixelRGBA8 from a Diagram B:

import           Codec.Picture.Types ( Image (..), PixelRGBA8 )
import           Diagrams.Backend.Rasterific
                   ( B, Rasterific (..), Options (..) )
import           Diagrams.Prelude ( Diagram, dims2D, renderDia )

renderDiagramToImage :: Int -> Int -> Diagram B -> Image PixelRGBA8
renderDiagramToImage width height =
  let size = dims2D (fromIntegral width) (fromIntegral height)
      options = RasterificOptions size
  in  renderDia Rasterific options

import Codec.Picture.Types ( Image (..), PixelRGBA8 )

import Diagrams.Backend.Rasterific

( B, Rasterific (..), Options (..) )

import Diagrams.Prelude ( Diagram, dims2D, renderDia )

renderDiagramToImage :: Int -> Int -> Diagram B -> Image PixelRGBA8

renderDiagramToImage width height =

let size = dims2D (fromIntegral width) (fromIntegral height)

options = RasterificOptions size

in renderDia Rasterific options

Picture

The gi-gtk package provides:

pictureNewForPaintable ::
     (HasCallStack, MonadIO m, IsPaintable obj)
  => Maybe obj
  -> m Picture

pictureNewForPaintable ::

(HasCallStack, MonadIO m, IsPaintable obj)

=> Maybe obj

-> m Picture

and the gi-gdk package provides Texture, which satisfies the IsPaintable constraint, and:

textureNewForPixbuf ::
     (HasCallStack, MonadIO m, IsPixbuf a) 
  => a
  -> m Texture

textureNewForPixbuf ::

(HasCallStack, MonadIO m, IsPixbuf a)

=> a

-> m Texture

So, the final step was to yield a Picture value from a Texture value and, in turn, a Texture value from a Pixbuf:

import           Diagrams.Backend.Rasterific ( B )
import           Diagrams.Prelude ( Diagram )
import           GI.Gdk ( textureNewForPixbuf )
import           GI.GdkPixbuf ( Pixbuf )
import qualified GI.Gtk as Gtk
import           Draw ( drawGrid, backgroundWidth, backgroundHeight )

renderDiagramToPixbuf :: Int -> Int -> Diagram B -> IO Pixbuf
renderDiagramToPixbuf width height diagram =
  imagePixelRGBA8ToPixbuf $ renderDiagramToImage width height diagram

activate :: Gtk.Application -> IO ()
activate app = do
...
  texture <- textureNewForPixbuf =<< renderDiagramToPixbuf
    backgroundWidth
    backgroundHeight
    (drawGrid newGrid)
  picture <- Gtk.pictureNewForPaintable (Just texture)

import Diagrams.Backend.Rasterific ( B )

import Diagrams.Prelude ( Diagram )

import GI.Gdk ( textureNewForPixbuf )

import GI.GdkPixbuf ( Pixbuf )

import qualified GI.Gtk as Gtk

import Draw ( drawGrid, backgroundWidth, backgroundHeight )

renderDiagramToPixbuf :: Int -> Int -> Diagram B -> IO Pixbuf

renderDiagramToPixbuf width height diagram =

imagePixelRGBA8ToPixbuf $ renderDiagramToImage width height diagram

activate :: Gtk.Application -> IO ()

activate app = do

...

texture <- textureNewForPixbuf =<< renderDiagramToPixbuf

backgroundWidth

backgroundHeight

(drawGrid newGrid)

picture <- Gtk.pictureNewForPaintable (Just texture)

imagePixelRGBA8ToPixbuf

The missing link was:

import           Codec.Picture.Types ( Image (..), PixelRGBA8 )
import qualified Data.Vector.Storable as SV
import           Foreign.Marshal.Alloc ( free, mallocBytes )
import           Foreign.Marshal.Utils ( copyBytes )
import           GI.GdkPixbuf ( Colorspace (..), Pixbuf, pixbufNewFromData )

imagePixelRGBA8ToPixbuf :: Image PixelRGBA8 -> IO Pixbuf
imagePixelRGBA8ToPixbuf image = do
  let w = imageWidth image
      h = imageHeight image
      rowStride = w * 4 -- 4 bytes per PixelRGBA8
      n = h * rowStride
  SV.unsafeWith (imageData image) $ \ptr -> do
     pixbufPtr <- mallocBytes n
     copyBytes pixbufPtr ptr n
     pixbufNewFromData
       pixbufPtr
       ColorspaceRgb
       True -- hasAlpha
       8 -- bitsPerSample
       (fromIntegral w) -- width
       (fromIntegral h) -- height
       (fromIntegral rowStride) -- rowStride
       (Just free) -- destroyFn

import Codec.Picture.Types ( Image (..), PixelRGBA8 )

import qualified Data.Vector.Storable as SV

import Foreign.Marshal.Alloc ( free, mallocBytes )

import Foreign.Marshal.Utils ( copyBytes )

import GI.GdkPixbuf ( Colorspace (..), Pixbuf, pixbufNewFromData )

imagePixelRGBA8ToPixbuf :: Image PixelRGBA8 -> IO Pixbuf

imagePixelRGBA8ToPixbuf image = do

let w = imageWidth image

h = imageHeight image

rowStride = w * 4 -- 4 bytes per PixelRGBA8

n = h * rowStride

SV.unsafeWith (imageData image) $ \ptr -> do

pixbufPtr <- mallocBytes n

copyBytes pixbufPtr ptr n

pixbufNewFromData

pixbufPtr

ColorspaceRgb

True -- hasAlpha

8 -- bitsPerSample

(fromIntegral w) -- width

(fromIntegral h) -- height

(fromIntegral rowStride) -- rowStride

(Just free) -- destroyFn

imageData image has type Data.Vector.Storable.Vector Word8. A buffer is allocated (mallocBytes n) and the bytes copied into it (copyBytes pixbufPtr ptr n). free is specified as the destroy function.

Haskell, GTK4 and pictures on the fly

Diagrams

Picture

imagePixelRGBA8ToPixbuf

Haskell, GTK4 and application icons